COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	BEGIN "FOURSOME"
C00008 ENDMK
C⊗;
BEGIN "FOURSOME";
DEFINE ⊂="BEGIN",⊃="END",$="COMMENT";
DEFINE BOARDS="6",PLAYERS="16";
INTEGER ARRAY SETA[0:16,0:6];		$ Adopted array;
INTEGER ARRAY SETB[0:16,0:6];		$ Adopted array;
INTEGER ARRAY SET[0:16,0:6];		$ Trial array;
INTEGER ARRAY REPEAT[0:16,0:16];	$ Actual repeats;
INTEGER ARRAY HIT[0:16,0:16];		$ Trial repeats;
INTEGER ARRAY PARDNER[0:16,0:16];	$ Actual pardners;
INTEGER ARRAY NONO[0:16,0:16];		$ Trial pardners;
INTEGER H,I,J,K,L,M,N,P,Q,R,T,U,CHAN,HITMAX,HITNUM,HITMA2,HITNU2;
STRING TALLY;
CHAN←1;
FOR J←1 STEP 1 UNTIL 6 DO
⊂ "JJ"
  T←J; U←0;
  FOR I←1 STEP 1 UNTIL 16 DO
  ⊂ "II"
    IF SET[I,J]>0 THEN CONTINUE "II";
    T←T-1;  IF T=0 THEN T←4; IF T>4 THEN T←T-4;
    SET[I,J]←(T LSH 27);
WHILE TRUE DO
⊂ "LL"
      FOR K←1 STEP 1 UNTIL 16 DO
      ⊂ "KK"
        IF SET[K,J]>0 THEN CONTINUE "KK";
        IF NONO[I,K]=0 THEN DONE "KK";
      ⊃ "KK";
      IF K>16 THEN
      ⊂ FOR K←1 STEP 1 UNTIL 16 DO
         OUTSTR(CVOS(SET[K,J])&" ");
         DONE "JJ"; ⊃;
      IF K>16 THEN
        ⊂ FOR K←1 STEP 1 UNTIL 16 DO
          IF SET[K,J]=0 THEN DONE; ⊃;
    NONO[I,K]←NONO[K,I]←1;
        ARRTRAN(SETA,SET);	$ Save in case a repeat is needed;
        ARRTRAN(REPEAT,HIT);
        ARRTRAN(PARDNER,NONO);
        HITMA2←HITMAX;  HITNU2←HITNUM;
    IF L>HITMAX THEN HITMAX←L;  IF L>0 THEN HITNUM←HITNUM+1;
    SET[I,J]←SET[I,J]+(K LSH 18);  SET[K,J]←SET[K,J]+(T LSH 27)+(I LSH 18);
    FOR Q←0 STEP 1 UNTIL 16 DO
    ⊂ "QQ"
      FOR M←16 STEP -1 UNTIL 1 DO
      ⊂ "MM"
        IF SET[M,J]>0 THEN CONTINUE "MM";
        IF HIT[I,M]+HIT[J,M]≤Q THEN DONE "QQ";
      ⊃ "MM";
    ⊃ "QQ";
    HIT[I,M]←HIT[I,M]+1;	HIT[K,M]←HIT[K,M]+1;
    HIT[M,I]←HIT[M,I]+1;	HIT[M,K]←HIT[M,K]+1;
    IF Q>HITMAX THEN HITMAX←Q;  IF Q>0 THEN HITNUM←HITNUM+1;
    SET[I,J]←SET[I,J]+M LSH 9;  SET[K,J]←SET[K,J]+M LSH 9;
    SET[M,J]←SET[M,J]+(T LSH 27)+(I LSH 9)+K;
    FOR R←0 STEP 1 UNTIL 16 DO
    ⊂ "RR"
      FOR N←1 STEP 1 UNTIL 16 DO
      ⊂ "NN"
        IF NONO[M,N]>0 THEN CONTINUE "NN";
        IF SET[N,J]>0 THEN CONTINUE "NN";
        IF HIT[I,N]+HIT[K,N]≤R THEN DONE "RR";
      ⊃ "NN";
    ⊃ "RR";
    IF N>16 THEN
    ⊂ FOR N←1 STEP 1 UNTIL 16 DO
       IF SET[N,J]>0 THEN U←U+1;
      IF U>11 THEN
       FOR N←1 STEP 1 UNTIL 16 DO
        IF SET[N,J]=0 THEN DONE ; ⊃;
    IF N>16 THEN
    ⊂ ARRTRAN(SET,SETA);		$ Restore and repeat with a new K;
      ARRTRAN(HIT,REPEAT);
      ARRTRAN(NONO,PARDNER);
      HITMAX←HITMA2;  HITNUM←HITNU2;
      CONTINUE "LL";  ⊃;
    IF R>HITMAX THEN HITMAX←R;  IF R>0 THEN HITNUM←HITNUM+1;
    NONO[M,N]←NONO[N,M]←1;
    SET[I,J]←SET[I,J]+N;	SET[K,J]←SET[K,J]+N;
    SET[M,J]←SET[M,J]+N LSH 18;
    SET[N,J]←SET[N,J]+(T LSH 27)+(M LSH 18)+(I LSH 9)+K;
    HIT[I,N]←HIT[I,N]+1;	HIT[K,N]←HIT[K,N]+1;
    HIT[N,I]←HIT[N,I]+1;	HIT[N,K]←HIT[N,K]+1;
    DONE "LL";
⊃ "LL";
  ⊃ "II";
⊃ "JJ";
OUTSTR("MAX HIT = "&CVS(HITMAX)&" NUM HITS = "&CVS(HITNUM));
TALLY←"\|\\M1CORON;\M2BDI40;\M3NGR40;";
P←0;
FOR I←1 STEP 1 UNTIL 16 DO
⊂ "III"
  TALLY←TALLY&"\F1	Player No. "
&CVS(I)&'11&"Name"&'15&'12&'15&'12&"\F2Round	Table		With		Score"&'15&'12;
  FOR J←1 STEP 1 UNTIL 6 DO
  ⊂ "JJJ"
    T←LDB(POINT(9,SET[I,J],8));
    K←LDB(POINT(9,SET[I,J],17));
    TALLY←TALLY&CVS(J)&'11&'11&CVS(T)&'11&'11&CVS(K)&'15&'12;
  ⊃ "JJJ";
  TALLY←TALLY&"\F3"&'11&'11&'11&'11&'11&"Total"&'15&'12&'15&'12&'15&'12&'15&'12;
  P←P+1;  IF P=3 THEN
   ⊂ P←0;  TALLY←TALLY&'14; ⊃
⊃ "III";
TALLY←TALLY&CVS(HITNUM)&" opponent duplications with a maximum of "&CVS(HITMAX);
CLOSE(CHAN); OPEN(CHAN,"DSK",0,0,2,0,0,0); 
ENTER(CHAN,"TALLY[ALS,ALS]",0);
OUT(CHAN,TALLY);
CLOSE(CHAN);
⊃ "FOURSOME";